home *** CD-ROM | disk | FTP | other *** search
/ Resource for Source: C/C++ / Resource for Source - C-C++.iso / misc_src / viswrite / file.bas < prev    next >
Encoding:
BASIC Source File  |  1995-11-01  |  9.6 KB  |  330 lines
  1. Option Explicit
  2.  
  3. Global Const GET_FILE_HANDLE = 2    ' Constant for FileAttr function
  4.  
  5. Const CONTROL_VERSION& = 20         ' Version number for document files
  6.  
  7. Type FILE_HEADER                    ' Structure for document file header
  8.     lVersion As Long
  9. End Type
  10.  
  11. '-------------------------------------------------------------------------
  12. ' FileOpenProc
  13. '
  14. ' This function is called when the user selects the "Open File..." menu
  15. ' or the corresponding button in the button bar. The function calls
  16. ' the "file open" common dialog box and passes the filename to OpenFile().
  17. '
  18. ' Parameters: -
  19. '-------------------------------------------------------------------------
  20. Sub FileOpenProc ()
  21.     Dim Filename As String
  22.     On Error Resume Next
  23.  
  24.     frmMDIParent.CMDialog1.DialogTitle = "Open file"
  25.     frmMDIParent.CMDialog1.Filename = ""
  26.     frmMDIParent.CMDialog1.Filter = "Text Control Demo (*.txm)|*.txm|Rich Text Format (*.rtf)|*.rtf"
  27.     frmMDIParent.CMDialog1.FilterIndex = 1
  28.     frmMDIParent.CMDialog1.Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  29.     frmMDIParent.CMDialog1.CancelError = True
  30.     frmMDIParent.CMDialog1.Action = DLG_FILE_OPEN
  31.     If Err Then Exit Sub
  32.  
  33.     Filename = frmMDIParent.CMDialog1.Filename
  34.     If UCase$(Right$(Filename, 3)) = "RTF" Then
  35.     OpenFile Filename, RTF_FILE
  36.     Else
  37.     OpenFile Filename, TXM_FILE
  38.     End If
  39. End Sub
  40.  
  41. '-------------------------------------------------------------------------
  42. ' FileSaveAsProc
  43. '
  44. ' Get new text filename and saves text
  45. '-------------------------------------------------------------------------
  46. Sub FileSaveAsProc ()
  47.     Dim Filename As String
  48.  
  49.     Filename = GetSaveFileName()
  50.     If Filename <> "" Then SaveFile (Filename)
  51.  
  52. End Sub
  53.  
  54. '-------------------------------------------------------------------------
  55. ' FileSaveProc
  56. '
  57. ' Save current text
  58. '-------------------------------------------------------------------------
  59. Sub FileSaveProc ()
  60.     Dim Filename As String
  61.  
  62.     If Left(frmMDIParent.ActiveForm.Caption, 8) = "Untitled" Then
  63.     ' The file hasn't been saved yet,
  64.     ' get the filename, then call the
  65.     ' save procedure
  66.     Filename = GetSaveFileName()
  67.     Else
  68.     ' The caption contains the name of the open file
  69.     Filename = frmMDIParent.ActiveForm.Caption
  70.     End If
  71.     ' Call the save procedure, if Filename = Empty then
  72.     ' the user selected Cancel in the Save As dialog, otherwise
  73.     ' save the file
  74.     If Filename <> "" Then
  75.     SaveFile Filename
  76.     End If
  77.  
  78. End Sub
  79.  
  80. '-------------------------------------------------------------------------
  81. ' GetSaveFileName
  82. '
  83. ' Get a new filename
  84. '-------------------------------------------------------------------------
  85. Function GetSaveFileName ()
  86.     'Displays a Save As dialog and returns a file name
  87.     'or an empty string if the user cancels
  88.     On Error Resume Next
  89.  
  90.     frmMDIParent.CMDialog1.DialogTitle = "Save As"
  91.     frmMDIParent.CMDialog1.Filter = "Text Control Demo (*.txm)|*.txm|Rich Text Format (*.rtf)|*.rtf"
  92.     frmMDIParent.CMDialog1.DefaultExt = "*.txm"
  93.     frmMDIParent.CMDialog1.Filename = ""
  94.     frmMDIParent.CMDialog1.Flags = OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT
  95.     frmMDIParent.CMDialog1.CancelError = True
  96.     frmMDIParent.CMDialog1.Action = DLG_FILE_SAVE
  97.  
  98.     If Err Then      'User canceled dialog
  99.     GetSaveFileName = ""
  100.     Else
  101.     GetSaveFileName = frmMDIParent.CMDialog1.Filename
  102.     End If
  103. End Function
  104.  
  105. '-------------------------------------------------------------------------
  106. ' InsertImageProc
  107. '
  108. ' Gets image file name and insert image
  109. '-------------------------------------------------------------------------
  110. Sub InsertImageProc ()
  111.     On Error Resume Next
  112.  
  113.     frmMDIParent.CMDialog1.DialogTitle = "Insert Image"
  114.     frmMDIParent.CMDialog1.Filename = ""
  115.     frmMDIParent.CMDialog1.Filter = "TIFF (*.tif)|*.tif|Bitmap Format (*.bmp *.dib)|*.bmp *.dib|Windows Metafile (*.wmf)|*.wmf"
  116.     frmMDIParent.CMDialog1.FilterIndex = 1
  117.     frmMDIParent.CMDialog1.Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  118.     frmMDIParent.CMDialog1.CancelError = True
  119.     frmMDIParent.CMDialog1.Action = DLG_FILE_OPEN
  120.     If Err Then Exit Sub
  121.  
  122.     frmMDIParent.ActiveForm.TextControl1.ImageInsert = frmMDIParent.CMDialog1.Filename
  123. End Sub
  124.  
  125. '-------------------------------------------------------------------------
  126. ' InsertTextProc
  127. '
  128. ' Get text file name and import text (ANSI or RTF)
  129. '-------------------------------------------------------------------------
  130. Sub InsertTextProc ()
  131.     Dim Filename As String      'current file name
  132.     Dim NameEnd As String
  133.     Dim Text As String          'file contents
  134.     Dim bOpen As Integer        'file open flag
  135.  
  136.     On Error Resume Next
  137.     bOpen = False
  138.  
  139.     NameEnd = UCase$(Right$(frmMDIParent.CMDialog1.Filename, 3))
  140.     If NameEnd = "RTF" Then
  141.     frmMDIParent.CMDialog1.FilterIndex = 2
  142.     Else
  143.     frmMDIParent.CMDialog1.FilterIndex = 1
  144.     If NameEnd <> "TXT" Then
  145.         frmMDIParent.CMDialog1.Filename = ""
  146.     End If
  147.     End If
  148.  
  149.     frmMDIParent.CMDialog1.DialogTitle = "Insert Text"
  150.     frmMDIParent.CMDialog1.Filter = "Text (*.txt)|*.txt|RTF Format (*.rtf)|*.rtf"
  151.     frmMDIParent.CMDialog1.Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  152.     frmMDIParent.CMDialog1.CancelError = True
  153.     frmMDIParent.CMDialog1.Action = DLG_FILE_OPEN
  154.     If Err Then Exit Sub
  155.  
  156.     Filename = frmMDIParent.CMDialog1.Filename
  157.     frmMDIParent.CMDialog1.Filename = frmMDIParent.CMDialog1.Filetitle
  158.  
  159.     screen.MousePointer = HOURGLASS
  160.  
  161.     If UCase$(Right$(Filename, 3)) = "RTF" Then
  162.     ' Import RTF file
  163.     frmMDIParent.ActiveForm.TextControl1.RTFImport = Filename
  164.     If Err Then
  165.         MsgBox "Can't import file: " + Filename
  166.     End If
  167.     Else
  168.     Open Filename For Binary As #1
  169.     If Err Then
  170.         MsgBox "Can't open file: " + Filename
  171.         GoTo cleanup_it
  172.     End If
  173.     bOpen = True
  174.  
  175.     ' Import text. The text size can be > 64K.
  176.     Do While Not EOF(1)
  177.         Text = Input$(10000, #1)
  178.         frmMDIParent.ActiveForm.TextControl1.SelText = Text
  179.     Loop
  180.  
  181.     If Err Then
  182.         MsgBox "Can't import file: " + Filename
  183.         GoTo cleanup_it
  184.     End If
  185.     End If
  186.  
  187. cleanup_it:
  188.     If bOpen = True Then
  189.     Close #1
  190.     End If
  191.     screen.MousePointer = DEFAULT
  192.  
  193. End Sub
  194.  
  195. '-------------------------------------------------------------------------
  196. ' OpenFile
  197. '
  198. ' Open the file given in the "filename" parameter, create a new MDI
  199. ' child and text control and load the file contents.
  200. '
  201. ' Parameters: FileName: Name of the file to be loaded (string)
  202. '             FileType: Type (TXM_FILE ot RTF_FILE)
  203. '-------------------------------------------------------------------------
  204. Sub OpenFile (Filename As String, FileType As Integer)
  205.     Dim FileHeader As FILE_HEADER
  206.     Dim fIndex As Integer
  207.     Dim bOpen As Integer
  208.     Dim bError As Integer
  209.  
  210.     On Error Resume Next
  211.  
  212.     bOpen = False
  213.     bError = True
  214.  
  215.     ' Create new document window
  216.     screen.MousePointer = HOURGLASS
  217.     fIndex = FindFreeIndex()
  218.     If fIndex = 0 Then GoTo cleanup_of
  219.     document(fIndex).Tag = fIndex
  220.  
  221.     If (FileType = RTF_FILE) Then
  222.     ' Load RTF file
  223.     document(fIndex).TextControl1.RTFImport = Filename
  224.     If Err Then
  225.         MsgBox "Can't load file: " + Filename
  226.         GoTo cleanup_of
  227.     End If
  228.     Else
  229.     ' Open the selected file
  230.     Open Filename For Binary As #1
  231.     If Err Then
  232.         MsgBox "Can't open file: " + Filename
  233.         GoTo cleanup_of
  234.     End If
  235.     bOpen = True
  236.  
  237.     ' Read file header
  238.     Get #1, , FileHeader
  239.     If FileHeader.lVersion <> CONTROL_VERSION Then
  240.         MsgBox "Wrong file type: " + Filename
  241.         GoTo cleanup_of
  242.     End If
  243.     ' Use the FileAttr function to get a DOS file handle
  244.     ' from the VisualBasic file number and pass it on to TX
  245.     document(fIndex).TextControl1.Load = FileAttr(1, GET_FILE_HANDLE)
  246.     If Err Then
  247.         MsgBox "Can't load file: " + Filename
  248.         GoTo cleanup_of
  249.     End If
  250.     End If
  251.  
  252.     ' Change form's caption and display new text
  253.     document(fIndex).Caption = UCase$(Filename)
  254.     document(fIndex).Show
  255.     bError = False
  256.  
  257. cleanup_of:
  258.     If bOpen = True Then
  259.     Close #1
  260.     End If
  261.  
  262.     If fIndex <> 0 Then
  263.     FState(fIndex).Ignore = True
  264.     FState(fIndex).Dirty = False
  265.  
  266.     If bError = True Then
  267.         FState(fIndex).Deleted = True
  268.         Unload document(fIndex)
  269.     End If
  270.     End If
  271.     screen.MousePointer = DEFAULT
  272.  
  273. End Sub
  274.  
  275. '-------------------------------------------------------------------------
  276. ' SaveFile
  277. '
  278. ' Save the contents of the active form in the file given in the
  279. ' "filename" parameter.
  280. '
  281. ' Parameters: FileName: Name of the file to be loaded (string)
  282. '-------------------------------------------------------------------------
  283. Sub SaveFile (Filename)
  284.     Dim FileHeader As FILE_HEADER
  285.     Dim FileType As Integer
  286.     On Error Resume Next
  287.  
  288.     ' Determine file type from filename extension
  289.     If UCase$(Right$(Filename, 3)) = "RTF" Then
  290.     FileType = RTF_FILE
  291.     Else
  292.     FileType = TXM_FILE
  293.     End If
  294.  
  295.     screen.MousePointer = HOURGLASS
  296.     
  297.     If (FileType = RTF_FILE) Then
  298.     ' Save RTF file
  299.     frmMDIParent.ActiveForm.TextControl1.RTFExport = Filename
  300.     Else
  301.     ' Open the file
  302.     Open Filename For Binary As #1
  303.     If Err Then
  304.         MsgBox "Can't open file: " + Filename
  305.         GoTo cleanup_sf
  306.     End If
  307.     ' Write file header
  308.     FileHeader.lVersion = CONTROL_VERSION
  309.     Put #1, , FileHeader
  310.     ' Write text control contents
  311.     frmMDIParent.ActiveForm.TextControl1.Save = FileAttr(1, GET_FILE_HANDLE)
  312.     Close #1
  313.     End If
  314.     
  315.     If Err Then
  316.     MsgBox "Can't save file: " + Filename
  317.     GoTo cleanup_sf
  318.     End If
  319.  
  320.     ' Set the window caption
  321.     frmMDIParent.ActiveForm.Caption = UCase$(Filename)
  322.     ' reset the dirty flag
  323.     FState(frmMDIParent.ActiveForm.Tag).Dirty = False
  324.  
  325. cleanup_sf:
  326.     screen.MousePointer = DEFAULT
  327.  
  328. End Sub
  329.  
  330.